Datos de observaciones actuales

ruta_productos <- "C:\\Users\\Usuario\\Downloads\\ARCHIVOS DE POSIT\\PRODUCTOS_2025.xlsx"
#"/cloud/project/PRODUCTOS_2025.xlsx"
excel_sheets(ruta_productos)
## [1] "Sheet 1"
Productos2025 <- as.data.frame(read_xlsx(ruta_productos, sheet ="Sheet 1"))
Productos2025$Mes <- format(Productos2025$Fecha, format ="%Y-%m")
Fecha2025 <- Productos2025$Fecha

Productos2025 <- Productos2025 %>% 
  group_by(Fecha = as.Date(Fecha)) %>% 
  summarize(Totales = sum(Totales), 
            .groups = "keep")
head(Productos2025)
## # A tibble: 6 × 2
## # Groups:   Fecha [6]
##   Fecha      Totales
##   <date>       <dbl>
## 1 2024-12-07   2926.
## 2 2025-01-03   2466.
## 3 2025-01-08   1672.
## 4 2025-01-09   7273.
## 5 2025-01-10  20880 
## 6 2025-01-11   8352
tail(Productos2025)
## # A tibble: 6 × 2
## # Groups:   Fecha [6]
##   Fecha      Totales
##   <date>       <dbl>
## 1 2025-02-24  14240.
## 2 2025-02-27  20630.
## 3 2025-03-06  66800.
## 4 2025-03-31  42850.
## 5 2025-04-08   4749.
## 6 2025-04-16    923.
nrow(Productos2025)
## [1] 32

Series

productoss_2025_ts <- ts(Productos2025$Totales,start =1, frequency =1)
productoss_2025_xts <- as.xts(productoss_2025_ts)

Gráfica de las serie

Datos historicos de productos 2019-2024

ruta <- "C:\\Users\\Usuario\\Downloads\\ARCHIVOS DE POSIT\\Ventas_Suministros_Totales.xlsx"
excel_sheets(ruta)
## [1] "Ventas Totales Original"    "Servicios Totales Original"
# "Ventas Totales Original"    "Servicios Totales Original"
Productos_Totales <- as.data.frame(read_xlsx(ruta, 
                                             sheet = "Ventas Totales Original"))
Productos_Totales$Semana <- format(Productos_Totales$Fecha, format = "%Y-%U")
Productos_Totales$mes <- format(Productos_Totales$Fecha, format = "%Y-%m")
head(Productos_Totales)
##   Folio               Fecha           RFC                       Empresa
## 1     1 2019-07-01 10:01:03 VEPS740807T84 Silvia Elena Velasco Palacios
## 2     2 2019-07-01 11:40:32 CERI890615EU1         ISRAEL CETINA ROSALES
## 3     2 2019-07-01 11:40:32 CERI890615EU1         ISRAEL CETINA ROSALES
## 4     2 2019-07-01 11:40:32 CERI890615EU1         ISRAEL CETINA ROSALES
## 5     2 2019-07-01 11:40:32 CERI890615EU1         ISRAEL CETINA ROSALES
## 6     2 2019-07-01 11:40:32 CERI890615EU1         ISRAEL CETINA ROSALES
##   Cantidad            Unidad
## 1        1 Bidón de plástico
## 2        1             Pieza
## 3        1             Pieza
## 4        1             Pieza
## 5        1             Pieza
## 6        1             Pieza
##                                                  Descripcion ValorUnitario
## 1 Algicin marca Spin en presentación de garrafa de 20 Litros        700.00
## 2                Kit de Sello y espaciadores Piston Superior        308.04
## 3                Kit de sello y espaciadores Piston Inferior        811.78
## 4                              Kit Piston Superior 9000/9100        968.58
## 5                              Kit Piston Inferior 9000/9100       1784.38
## 6                               Engrane motriz Inferior 9100       1092.00
##       Total  Semana     mes
## 1  812.0000 2019-26 2019-07
## 2  357.3264 2019-26 2019-07
## 3  941.6648 2019-26 2019-07
## 4 1123.5528 2019-26 2019-07
## 5 2069.8808 2019-26 2019-07
## 6 1266.7200 2019-26 2019-07
nrow(Productos_Totales)
## [1] 1995
productos <- data.frame(Fecha = Productos_Totales$Fecha, Totales = Productos_Totales$Total)

Suma de historicos

productos <- productos %>% 
  group_by(Fecha = as.Date(Fecha)) %>% 
  summarize(Totales = sum(Totales), 
            .groups = "keep")
head(productos)
## # A tibble: 6 × 2
## # Groups:   Fecha [6]
##   Fecha      Totales
##   <date>       <dbl>
## 1 2019-07-01  25826.
## 2 2019-07-03   3138.
## 3 2019-07-04   5330.
## 4 2019-07-05  10146.
## 5 2019-07-06  10962 
## 6 2019-07-08  16194.
nrow(productos)
## [1] 695

Serie

productos_ts <- ts(productos$Totales, start = 1, frequency = 1)

Gráfica por dia

Union de los datos

PRODTOTAL <- merge(x = productos, y = Productos2025, all = T)
head(PRODTOTAL)
##        Fecha   Totales
## 1 2019-07-01 25826.333
## 2 2019-07-03  3137.800
## 3 2019-07-04  5329.713
## 4 2019-07-05 10145.534
## 5 2019-07-06 10962.000
## 6 2019-07-08 16193.600
tail(PRODTOTAL)
##          Fecha  Totales
## 722 2025-02-24 14240.16
## 723 2025-02-27 20630.00
## 724 2025-03-06 66799.76
## 725 2025-03-31 42850.40
## 726 2025-04-08  4749.04
## 727 2025-04-16   923.36
nrow(PRODTOTAL)
## [1] 727

Serie mensual

prodmes_ts <- ts(PRODTOTAL$Totales, start = c(2019,07,01), 
                 end = c(2025,04,16),frequency = 12)
prodmes_ts
##             Jan        Feb        Mar        Apr        May        Jun
## 2019                                                                  
## 2020   5476.894   3264.820   2591.452   1604.837   8224.783   6308.544
## 2021   1021.890   1271.894   2621.600    232.000   1021.890  21133.042
## 2022   1024.930   1765.334   2408.427   4415.981  15757.660  25711.017
## 2023   5909.272  10100.445   3357.922   1049.348  17229.480   6295.042
## 2024 285984.952  34886.165  10962.000  18731.030   4778.272   2925.520
## 2025  22960.483   9231.744  10499.763  13336.787                      
##             Jul        Aug        Sep        Oct        Nov        Dec
## 2019  25826.333   3137.800   5329.713  10145.534  10962.000  16193.600
## 2020   4048.400  11098.950   2992.800  23387.062   4384.800   2259.402
## 2021   8769.600   1851.360   8769.600   3966.040  23594.400   7424.000
## 2022  20318.131   6322.000   2009.468  35523.562  20083.811   8769.600
## 2023   3853.497   2204.000   2273.600  16639.040  13033.760   2817.895
## 2024  21151.579   4162.451  25828.699   6090.000  60236.654   1921.482
## 2025
length(prodmes_ts)
## [1] 70
# 70 - 4 meses de 2025 = 66 de 2019-2024
#Fecha final de historicos

Gráfica

Transformación

PRODTOTAL$Mes <- format(PRODTOTAL$Fecha, format = "%Y-%m")

lambda <- boxcox(x = as.numeric(prodmes_ts), objective.name = "Log-Likelihood", optimize = T)
lambda$lambda
## [1] -0.03199604
# [1] -0.03199604
PM <- boxcoxTransform(x = as.numeric(prodmes_ts), lambda = lambda$lambda )
head(PM)
## [1] 8.673280 7.097835 7.503846 7.988022 8.045570 8.333507
tail(PM)
## [1] 9.276931 6.715797 8.588141 7.917654 8.013556 8.190726
length(PM)
## [1] 70

Serie mensual con boxcox

serie_mensual_prod <- ts(PM, start = 1, frequency = 1)

Grafica mensual

ts_plot(serie_mensual_prod, color = "blue", Xtitle = "Meses", Ytitle = "Valores", 
        title = " Serie mensual de productos")

Diferenciar

ndiffs(serie_mensual_prod[1:66])
## [1] 0

ACF y PACF

ggAcf(serie_mensual_prod[1:66], col = "red", lwd = 2, lag.max = 50)

ggPacf(serie_mensual_prod[1:66], col = "blue", lwd = 2, lag.max = 50)

Modelo

ARIMA_PM <- auto.arima(y = serie_mensual_prod[1:66], stationary = F, seasonal = F, stepwise = F, trace = T)
## 
##  ARIMA(0,0,0) with zero mean     : 458.0487
##  ARIMA(0,0,0) with non-zero mean : 176.2192
##  ARIMA(0,0,1) with zero mean     : 382.9475
##  ARIMA(0,0,1) with non-zero mean : 175.8488
##  ARIMA(0,0,2) with zero mean     : 339.4598
##  ARIMA(0,0,2) with non-zero mean : 177.993
##  ARIMA(0,0,3) with zero mean     : 309.9792
##  ARIMA(0,0,3) with non-zero mean : 179.6661
##  ARIMA(0,0,4) with zero mean     : 292.3764
##  ARIMA(0,0,4) with non-zero mean : 182.0679
##  ARIMA(0,0,5) with zero mean     : 281.003
##  ARIMA(0,0,5) with non-zero mean : 184.5604
##  ARIMA(1,0,0) with zero mean     : 210.1503
##  ARIMA(1,0,0) with non-zero mean : 175.6345
##  ARIMA(1,0,1) with zero mean     : Inf
##  ARIMA(1,0,1) with non-zero mean : 177.6986
##  ARIMA(1,0,2) with zero mean     : Inf
##  ARIMA(1,0,2) with non-zero mean : 180.0209
##  ARIMA(1,0,3) with zero mean     : Inf
##  ARIMA(1,0,3) with non-zero mean : 182.0722
##  ARIMA(1,0,4) with zero mean     : Inf
##  ARIMA(1,0,4) with non-zero mean : 183.7953
##  ARIMA(2,0,0) with zero mean     : Inf
##  ARIMA(2,0,0) with non-zero mean : 177.7984
##  ARIMA(2,0,1) with zero mean     : Inf
##  ARIMA(2,0,1) with non-zero mean : 180.0297
##  ARIMA(2,0,2) with zero mean     : Inf
##  ARIMA(2,0,2) with non-zero mean : 182.3055
##  ARIMA(2,0,3) with zero mean     : Inf
##  ARIMA(2,0,3) with non-zero mean : Inf
##  ARIMA(3,0,0) with zero mean     : Inf
##  ARIMA(3,0,0) with non-zero mean : 179.7691
##  ARIMA(3,0,1) with zero mean     : Inf
##  ARIMA(3,0,1) with non-zero mean : 182.1048
##  ARIMA(3,0,2) with zero mean     : Inf
##  ARIMA(3,0,2) with non-zero mean : Inf
##  ARIMA(4,0,0) with zero mean     : Inf
##  ARIMA(4,0,0) with non-zero mean : 182.0962
##  ARIMA(4,0,1) with zero mean     : Inf
##  ARIMA(4,0,1) with non-zero mean : 184.5791
##  ARIMA(5,0,0) with zero mean     : Inf
##  ARIMA(5,0,0) with non-zero mean : 184.6027
## 
## 
## 
##  Best model: ARIMA(1,0,0) with non-zero mean
summary(ARIMA_PM)
## Series: serie_mensual_prod[1:66] 
## ARIMA(1,0,0) with non-zero mean 
## 
## Coefficients:
##          ar1    mean
##       0.2054  7.6048
## s.e.  0.1217  0.1345
## 
## sigma^2 = 0.784:  log likelihood = -84.62
## AIC=175.25   AICc=175.63   BIC=181.82
## 
## Training set error measures:
##                       ME      RMSE       MAE       MPE     MAPE      MASE
## Training set -0.00366912 0.8718936 0.7001175 -1.408411 9.401275 0.7716353
##                      ACF1
## Training set -0.009499828

Residuales

checkresiduals(ARIMA_PM, col = "darkgreen")

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(1,0,0) with non-zero mean
## Q* = 3.4953, df = 9, p-value = 0.9414
## 
## Model df: 1.   Total lags used: 10
# p-value = 0.9414

Criterio AIC

AIC(ARIMA_PM)
## [1] 175.2474
# [1] 175.2474

Pronóstico

pron <- forecast(object = ARIMA_PM, h = length(serie_mensual_prod[67:70]), level = 0.95)
summary(pron)
## 
## Forecast method: ARIMA(1,0,0) with non-zero mean
## 
## Model Information:
## Series: serie_mensual_prod[1:66] 
## ARIMA(1,0,0) with non-zero mean 
## 
## Coefficients:
##          ar1    mean
##       0.2054  7.6048
## s.e.  0.1217  0.1345
## 
## sigma^2 = 0.784:  log likelihood = -84.62
## AIC=175.25   AICc=175.63   BIC=181.82
## 
## Error measures:
##                       ME      RMSE       MAE       MPE     MAPE      MASE
## Training set -0.00366912 0.8718936 0.7001175 -1.408411 9.401275 0.7716353
##                      ACF1
## Training set -0.009499828
## 
## Forecasts:
##    Point Forecast    Lo 95    Hi 95
## 67       7.422243 5.686867 9.157619
## 68       7.567314 5.795725 9.338902
## 69       7.597104 5.824005 9.370204
## 70       7.603222 5.830059 9.376385
pron <- data.frame(pronosticos = pron, actuales = as.numeric(serie_mensual_prod[67:70]))
colnames(pron) <- c("pronosticos", "Limite_inf", "Limite_sup", "actuales")
head(pron)
##    pronosticos Limite_inf Limite_sup actuales
## 67    7.422243   5.686867   9.157619 8.588141
## 68    7.567314   5.795725   9.338902 7.917654
## 69    7.597104   5.824005   9.370204 8.013556
## 70    7.603222   5.830059   9.376385 8.190726
tail(pron)
##    pronosticos Limite_inf Limite_sup actuales
## 67    7.422243   5.686867   9.157619 8.588141
## 68    7.567314   5.795725   9.338902 7.917654
## 69    7.597104   5.824005   9.370204 8.013556
## 70    7.603222   5.830059   9.376385 8.190726
nrow(pron)
## [1] 4

Exactitud

accuracy(pron$pronosticos, serie_mensual_prod[67:70])
##                 ME      RMSE       MAE     MPE    MAPE
## Test set 0.6300487 0.7072218 0.6300487 7.59253 7.59253

Gráficas de los pronósticos

Inverso de Boxcox

valores_reales <- InvBoxCox(x = pron, lambda = -0.03199604)
valores_reales
##    pronosticos Limite_inf Limite_sup  actuales
## 67    4787.915   532.2146   50859.29 22960.485
## 68    5794.615   608.1385   65794.44  9231.745
## 69    6027.076   629.6348   68800.28 10499.764
## 70    6075.992   634.3376   69410.43 13336.788

Gráfica de los valores

Excactitud real

accuracy(valores_reales$pronosticos,valores_reales$actuales)
##                ME     RMSE      MAE      MPE     MAPE
## Test set 8335.796 10183.08 8335.796 53.35466 53.35466